home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / FFC / _BASE.PRG < prev    next >
Encoding:
Text File  |  1998-05-26  |  36.4 KB  |  1,759 lines
  1. **************************************************
  2. *-- Class Library:  d:\vfp\ffc\_base.prg
  3. **************************************************
  4.  
  5.  
  6.  
  7.  
  8.  
  9. **************************************************
  10. *-- Class:        _column (d:\vfp\ffc\_base.prg)
  11. *-- ParentClass:  column 
  12. *-- BaseClass:    column 
  13. *
  14. DEFINE CLASS _column AS column
  15.  
  16.  
  17.     Name = "_column"
  18.     cVersion = ""
  19.     Builder = ""
  20.     BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm")
  21.     oHost = .NULL.
  22.     vResult = .T.
  23.     cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
  24.     lAutoBuilder = .F.
  25.     lAutoSetObjectRefs = .F.
  26.     lRelease = .F.
  27.     lIgnoreErrors = .F.
  28.     lSetHost = .F.
  29.     nInstances = 0
  30.     nObjectRefCount = 0
  31.     DIMENSION aObjectRefs[1,3]
  32.  
  33.  
  34.     PROCEDURE nInstances_access
  35.     LOCAL laInstances[1]
  36.     
  37.     RETURN AINSTANCE(laInstances,this.Class)
  38.     ENDPROC
  39.  
  40.  
  41.     PROCEDURE nInstances_assign
  42.         LPARAMETERS m.vNewVal
  43.  
  44.         ERROR 1743
  45.     ENDPROC
  46.  
  47.  
  48.     PROCEDURE release
  49.         IF this.lRelease
  50.             NODEFAULT
  51.             RETURN .F.
  52.         ENDIF
  53.         this.lRelease=.T.
  54.         this.oHost=.NULL.
  55.         this.ReleaseObjRefs
  56.         RELEASE this
  57.     ENDPROC
  58.  
  59.  
  60.     PROCEDURE setobjectref
  61.         LPARAMETERS tcName,tvClass,tvClassLibrary
  62.         LOCAL lvResult
  63.  
  64.         this.vResult=.T.
  65.         DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
  66.         lvResult=this.vResult
  67.         this.vResult=.T.
  68.         RETURN lvResult
  69.     ENDPROC
  70.  
  71.  
  72.     PROCEDURE setobjectrefs
  73.         LPARAMETERS toObject
  74.  
  75.         RETURN
  76.     ENDPROC
  77.  
  78.  
  79.     PROCEDURE releaseobjrefs
  80.         LOCAL lcName,oObject,lnCount
  81.  
  82.         IF this.nObjectRefCount=0
  83.             RETURN
  84.         ENDIF
  85.         FOR lnCount = this.nObjectRefCount TO 1 STEP -1
  86.             lcName=this.aObjectRefs[lnCount,1]
  87.             IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
  88.                 LOOP
  89.             ENDIF
  90.             oObject=this.&lcName
  91.             IF ISNULL(oObject)
  92.                 LOOP
  93.             ENDIF
  94.             IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
  95.                 oObject.Release
  96.             ENDIF
  97.             IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
  98.                 oObject.oHost=.NULL.
  99.             ENDIF
  100.             this.&lcName=.NULL.
  101.             oObject=.NULL.
  102.         ENDFOR
  103.         DIMENSION this.aObjectRefs[1,3]
  104.         this.aObjectRefs=""
  105.     ENDPROC
  106.  
  107.  
  108.     PROCEDURE nobjectrefcount_access
  109.         LOCAL lnObjectRefCount
  110.  
  111.         lnObjectRefCount=ALEN(this.aObjectRefs,1)
  112.         IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
  113.             lnObjectRefCount=0
  114.         ENDIF
  115.         RETURN lnObjectRefCount
  116.     ENDPROC
  117.  
  118.  
  119.     PROCEDURE nobjectrefcount_assign
  120.         LPARAMETERS m.vNewVal
  121.  
  122.         ERROR 1743
  123.     ENDPROC
  124.  
  125.  
  126.     PROCEDURE sethost
  127.         this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
  128.     ENDPROC
  129.  
  130.  
  131.     PROCEDURE newinstance
  132.         LPARAMETERS tnDataSessionID
  133.         LOCAL oNewObject,lnLastDataSessionID
  134.  
  135.         lnLastDataSessionID=SET("DATASESSION")
  136.         IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
  137.             SET DATASESSION TO tnDataSessionID
  138.         ENDIF
  139.         oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
  140.         SET DATASESSION TO (lnLastDataSessionID)
  141.         RETURN oNewObject
  142.     ENDPROC
  143.  
  144.  
  145.     PROCEDURE Destroy
  146.         IF this.lRelease
  147.             RETURN .F.
  148.         ENDIF
  149.         this.lRelease=.T.
  150.         this.ReleaseObjRefs
  151.         this.oHost=.NULL.
  152.     ENDPROC
  153.  
  154.  
  155.     PROCEDURE Init
  156.         IF this.lSetHost
  157.             this.SetHost
  158.         ENDIF
  159.         IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
  160.             RETURN .F.
  161.         ENDIF
  162.     ENDPROC
  163.  
  164.  
  165.     PROCEDURE Error
  166.         LPARAMETERS nError, cMethod, nLine
  167.         LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
  168.  
  169.         IF this.lIgnoreErrors
  170.             RETURN .F.
  171.         ENDIF
  172.         lcOnError=UPPER(ALLTRIM(ON("ERROR")))
  173.         IF NOT EMPTY(lcOnError)
  174.             lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
  175.                     "PROGRAM()","cMethod"),"LINENO()","nLine")
  176.             &lcOnError
  177.             RETURN
  178.         ENDIF
  179.         lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
  180.                 "Error:           "+ALLTRIM(STR(nError))+CHR(13)+ ;
  181.                 "Method:       "+LOWER(ALLTRIM(cMethod))
  182.         lcCodeLineMsg=MESSAGE(1)
  183.         IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
  184.             lcErrorMsg=lcErrorMsg+CHR(13)+"Line:            "+ALLTRIM(STR(nLine))
  185.             IF NOT EMPTY(lcCodeLineMsg)
  186.                 lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  187.             ENDIF
  188.         ENDIF
  189.         WAIT CLEAR
  190.         MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
  191.         ERROR nError
  192.     ENDPROC
  193.  
  194.  
  195. ENDDEFINE
  196. *
  197. *-- EndDefine: _column
  198. **************************************************
  199.  
  200.  
  201.  
  202.  
  203.  
  204. **************************************************
  205. *-- Class:        _cursor (d:\vfp\ffc\_base.prg)
  206. *-- ParentClass:  cursor
  207. *-- BaseClass:    cursor
  208. *
  209. DEFINE CLASS _cursor AS cursor
  210.  
  211.  
  212.     Name = "_cursor"
  213.     cVersion = ""
  214.     Builder = ""
  215.     BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm")
  216.     oHost = .NULL.
  217.     vResult = .T.
  218.     cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
  219.     lAutoBuilder = .F.
  220.     lAutoSetObjectRefs = .F.
  221.     lRelease = .F.
  222.     lIgnoreErrors = .F.
  223.     lSetHost = .F.
  224.     nInstances = 0
  225.     nObjectRefCount = 0
  226.     DIMENSION aObjectRefs[1,3]
  227.  
  228.  
  229.     PROCEDURE nInstances_access
  230.     LOCAL laInstances[1]
  231.     
  232.     RETURN AINSTANCE(laInstances,this.Class)
  233.     ENDPROC
  234.  
  235.  
  236.     PROCEDURE nInstances_assign
  237.         LPARAMETERS m.vNewVal
  238.  
  239.         ERROR 1743
  240.     ENDPROC
  241.  
  242.  
  243.     PROCEDURE release
  244.         IF this.lRelease
  245.             NODEFAULT
  246.             RETURN .F.
  247.         ENDIF
  248.         this.lRelease=.T.
  249.         this.oHost=.NULL.
  250.         this.ReleaseObjRefs
  251.         RELEASE this
  252.     ENDPROC
  253.  
  254.  
  255.     PROCEDURE setobjectref
  256.         LPARAMETERS tcName,tvClass,tvClassLibrary
  257.         LOCAL lvResult
  258.  
  259.         this.vResult=.T.
  260.         DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
  261.         lvResult=this.vResult
  262.         this.vResult=.T.
  263.         RETURN lvResult
  264.     ENDPROC
  265.  
  266.  
  267.     PROCEDURE setobjectrefs
  268.         LPARAMETERS toObject
  269.  
  270.         RETURN
  271.     ENDPROC
  272.  
  273.  
  274.     PROCEDURE releaseobjrefs
  275.         LOCAL lcName,oObject,lnCount
  276.  
  277.         IF this.nObjectRefCount=0
  278.             RETURN
  279.         ENDIF
  280.         FOR lnCount = this.nObjectRefCount TO 1 STEP -1
  281.             lcName=this.aObjectRefs[lnCount,1]
  282.             IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
  283.                 LOOP
  284.             ENDIF
  285.             oObject=this.&lcName
  286.             IF ISNULL(oObject)
  287.                 LOOP
  288.             ENDIF
  289.             IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
  290.                 oObject.Release
  291.             ENDIF
  292.             IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
  293.                 oObject.oHost=.NULL.
  294.             ENDIF
  295.             this.&lcName=.NULL.
  296.             oObject=.NULL.
  297.         ENDFOR
  298.         DIMENSION this.aObjectRefs[1,3]
  299.         this.aObjectRefs=""
  300.     ENDPROC
  301.  
  302.  
  303.     PROCEDURE nobjectrefcount_access
  304.         LOCAL lnObjectRefCount
  305.  
  306.         lnObjectRefCount=ALEN(this.aObjectRefs,1)
  307.         IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
  308.             lnObjectRefCount=0
  309.         ENDIF
  310.         RETURN lnObjectRefCount
  311.     ENDPROC
  312.  
  313.  
  314.     PROCEDURE nobjectrefcount_assign
  315.         LPARAMETERS m.vNewVal
  316.  
  317.         ERROR 1743
  318.     ENDPROC
  319.  
  320.  
  321.     PROCEDURE sethost
  322.         this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
  323.     ENDPROC
  324.  
  325.  
  326.     PROCEDURE newinstance
  327.         LPARAMETERS tnDataSessionID
  328.         LOCAL oNewObject,lnLastDataSessionID
  329.  
  330.         lnLastDataSessionID=SET("DATASESSION")
  331.         IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
  332.             SET DATASESSION TO tnDataSessionID
  333.         ENDIF
  334.         oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
  335.         SET DATASESSION TO (lnLastDataSessionID)
  336.         RETURN oNewObject
  337.     ENDPROC
  338.  
  339.  
  340.     PROCEDURE Destroy
  341.         IF this.lRelease
  342.             RETURN .F.
  343.         ENDIF
  344.         this.lRelease=.T.
  345.         this.ReleaseObjRefs
  346.         this.oHost=.NULL.
  347.     ENDPROC
  348.  
  349.  
  350.     PROCEDURE Init
  351.         IF this.lSetHost
  352.             this.SetHost
  353.         ENDIF
  354.         IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
  355.             RETURN .F.
  356.         ENDIF
  357.     ENDPROC
  358.  
  359.  
  360.     PROCEDURE Error
  361.         LPARAMETERS nError, cMethod, nLine
  362.         LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
  363.  
  364.         IF this.lIgnoreErrors
  365.             RETURN .F.
  366.         ENDIF
  367.         lcOnError=UPPER(ALLTRIM(ON("ERROR")))
  368.         IF NOT EMPTY(lcOnError)
  369.             lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
  370.                     "PROGRAM()","cMethod"),"LINENO()","nLine")
  371.             &lcOnError
  372.             RETURN
  373.         ENDIF
  374.         lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
  375.                 "Error:           "+ALLTRIM(STR(nError))+CHR(13)+ ;
  376.                 "Method:       "+LOWER(ALLTRIM(cMethod))
  377.         lcCodeLineMsg=MESSAGE(1)
  378.         IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
  379.             lcErrorMsg=lcErrorMsg+CHR(13)+"Line:            "+ALLTRIM(STR(nLine))
  380.             IF NOT EMPTY(lcCodeLineMsg)
  381.                 lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  382.             ENDIF
  383.         ENDIF
  384.         WAIT CLEAR
  385.         MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
  386.         ERROR nError
  387.     ENDPROC
  388.  
  389.  
  390. ENDDEFINE
  391. *
  392. *-- EndDefine: _cursor
  393. **************************************************
  394.  
  395.  
  396.  
  397.  
  398.  
  399. **************************************************
  400. *-- Class:        _dataenvironment (d:\vfp\ffc\_base.prg)
  401. *-- ParentClass:  dataenvironment
  402. *-- BaseClass:    dataenvironment
  403. *
  404. DEFINE CLASS _dataenvironment AS dataenvironment
  405.  
  406.  
  407.     Name = "_dataenvironment"
  408.     cVersion = ""
  409.     Builder = ""
  410.     BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm")
  411.     oHost = .NULL.
  412.     vResult = .T.
  413.     cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
  414.     lAutoBuilder = .F.
  415.     lAutoSetObjectRefs = .F.
  416.     lRelease = .F.
  417.     lIgnoreErrors = .F.
  418.     lSetHost = .F.
  419.     nInstances = 0
  420.     nObjectRefCount = 0
  421.     DIMENSION aObjectRefs[1,3]
  422.  
  423.  
  424.     PROCEDURE nInstances_access
  425.     LOCAL laInstances[1]
  426.     
  427.     RETURN AINSTANCE(laInstances,this.Class)
  428.     ENDPROC
  429.  
  430.  
  431.     PROCEDURE nInstances_assign
  432.         LPARAMETERS m.vNewVal
  433.  
  434.         ERROR 1743
  435.     ENDPROC
  436.  
  437.  
  438.     PROCEDURE release
  439.         IF this.lRelease
  440.             NODEFAULT
  441.             RETURN .F.
  442.         ENDIF
  443.         this.lRelease=.T.
  444.         this.oHost=.NULL.
  445.         this.ReleaseObjRefs
  446.         RELEASE this
  447.     ENDPROC
  448.  
  449.  
  450.     PROCEDURE setobjectref
  451.         LPARAMETERS tcName,tvClass,tvClassLibrary
  452.         LOCAL lvResult
  453.  
  454.         this.vResult=.T.
  455.         DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
  456.         lvResult=this.vResult
  457.         this.vResult=.T.
  458.         RETURN lvResult
  459.     ENDPROC
  460.  
  461.  
  462.     PROCEDURE setobjectrefs
  463.         LPARAMETERS toObject
  464.  
  465.         RETURN
  466.     ENDPROC
  467.  
  468.  
  469.     PROCEDURE releaseobjrefs
  470.         LOCAL lcName,oObject,lnCount
  471.  
  472.         IF this.nObjectRefCount=0
  473.             RETURN
  474.         ENDIF
  475.         FOR lnCount = this.nObjectRefCount TO 1 STEP -1
  476.             lcName=this.aObjectRefs[lnCount,1]
  477.             IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
  478.                 LOOP
  479.             ENDIF
  480.             oObject=this.&lcName
  481.             IF ISNULL(oObject)
  482.                 LOOP
  483.             ENDIF
  484.             IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
  485.                 oObject.Release
  486.             ENDIF
  487.             IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
  488.                 oObject.oHost=.NULL.
  489.             ENDIF
  490.             this.&lcName=.NULL.
  491.             oObject=.NULL.
  492.         ENDFOR
  493.         DIMENSION this.aObjectRefs[1,3]
  494.         this.aObjectRefs=""
  495.     ENDPROC
  496.  
  497.  
  498.     PROCEDURE nobjectrefcount_access
  499.         LOCAL lnObjectRefCount
  500.  
  501.         lnObjectRefCount=ALEN(this.aObjectRefs,1)
  502.         IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
  503.             lnObjectRefCount=0
  504.         ENDIF
  505.         RETURN lnObjectRefCount
  506.     ENDPROC
  507.  
  508.  
  509.     PROCEDURE nobjectrefcount_assign
  510.         LPARAMETERS m.vNewVal
  511.  
  512.         ERROR 1743
  513.     ENDPROC
  514.  
  515.  
  516.     PROCEDURE sethost
  517.         this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
  518.     ENDPROC
  519.  
  520.  
  521.     PROCEDURE newinstance
  522.         LPARAMETERS tnDataSessionID
  523.         LOCAL oNewObject,lnLastDataSessionID
  524.  
  525.         lnLastDataSessionID=SET("DATASESSION")
  526.         IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
  527.             SET DATASESSION TO tnDataSessionID
  528.         ENDIF
  529.         oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
  530.         SET DATASESSION TO (lnLastDataSessionID)
  531.         RETURN oNewObject
  532.     ENDPROC
  533.  
  534.  
  535.     PROCEDURE Destroy
  536.         IF this.lRelease
  537.             RETURN .F.
  538.         ENDIF
  539.         this.lRelease=.T.
  540.         this.ReleaseObjRefs
  541.         this.oHost=.NULL.
  542.     ENDPROC
  543.  
  544.  
  545.     PROCEDURE Init
  546.         IF this.lSetHost
  547.             this.SetHost
  548.         ENDIF
  549.         IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
  550.             RETURN .F.
  551.         ENDIF
  552.     ENDPROC
  553.  
  554.  
  555.     PROCEDURE Error
  556.         LPARAMETERS nError, cMethod, nLine
  557.         LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
  558.  
  559.         IF this.lIgnoreErrors
  560.             RETURN .F.
  561.         ENDIF
  562.         lcOnError=UPPER(ALLTRIM(ON("ERROR")))
  563.         IF NOT EMPTY(lcOnError)
  564.             lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
  565.                     "PROGRAM()","cMethod"),"LINENO()","nLine")
  566.             &lcOnError
  567.             RETURN
  568.         ENDIF
  569.         lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
  570.                 "Error:           "+ALLTRIM(STR(nError))+CHR(13)+ ;
  571.                 "Method:       "+LOWER(ALLTRIM(cMethod))
  572.         lcCodeLineMsg=MESSAGE(1)
  573.         IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
  574.             lcErrorMsg=lcErrorMsg+CHR(13)+"Line:            "+ALLTRIM(STR(nLine))
  575.             IF NOT EMPTY(lcCodeLineMsg)
  576.                 lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  577.             ENDIF
  578.         ENDIF
  579.         WAIT CLEAR
  580.         MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
  581.         ERROR nError
  582.     ENDPROC
  583.  
  584.  
  585. ENDDEFINE
  586. *
  587. *-- EndDefine: _dataenvironment
  588. **************************************************
  589.  
  590.  
  591.  
  592.  
  593.  
  594. **************************************************
  595. *-- Class:        _header (d:\vfp\ffc\_base.prg)
  596. *-- ParentClass:  header
  597. *-- BaseClass:    header
  598. *
  599. DEFINE CLASS _header AS header
  600.  
  601.  
  602.     Name = "_header"
  603.     cVersion = ""
  604.     Builder = ""
  605.     BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm")
  606.     oHost = .NULL.
  607.     vResult = .T.
  608.     cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
  609.     lAutoBuilder = .F.
  610.     lAutoSetObjectRefs = .F.
  611.     lRelease = .F.
  612.     lIgnoreErrors = .F.
  613.     lSetHost = .F.
  614.     nInstances = 0
  615.     nObjectRefCount = 0
  616.     DIMENSION aObjectRefs[1,3]
  617.  
  618.  
  619.     PROCEDURE nInstances_access
  620.     LOCAL laInstances[1]
  621.     
  622.     RETURN AINSTANCE(laInstances,this.Class)
  623.     ENDPROC
  624.  
  625.  
  626.     PROCEDURE nInstances_assign
  627.         LPARAMETERS m.vNewVal
  628.  
  629.         ERROR 1743
  630.     ENDPROC
  631.  
  632.  
  633.     PROCEDURE release
  634.         IF this.lRelease
  635.             NODEFAULT
  636.             RETURN .F.
  637.         ENDIF
  638.         this.lRelease=.T.
  639.         this.oHost=.NULL.
  640.         this.ReleaseObjRefs
  641.         RELEASE this
  642.     ENDPROC
  643.  
  644.  
  645.     PROCEDURE setobjectref
  646.         LPARAMETERS tcName,tvClass,tvClassLibrary
  647.         LOCAL lvResult
  648.  
  649.         this.vResult=.T.
  650.         DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
  651.         lvResult=this.vResult
  652.         this.vResult=.T.
  653.         RETURN lvResult
  654.     ENDPROC
  655.  
  656.  
  657.     PROCEDURE setobjectrefs
  658.         LPARAMETERS toObject
  659.  
  660.         RETURN
  661.     ENDPROC
  662.  
  663.  
  664.     PROCEDURE releaseobjrefs
  665.         LOCAL lcName,oObject,lnCount
  666.  
  667.         IF this.nObjectRefCount=0
  668.             RETURN
  669.         ENDIF
  670.         FOR lnCount = this.nObjectRefCount TO 1 STEP -1
  671.             lcName=this.aObjectRefs[lnCount,1]
  672.             IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
  673.                 LOOP
  674.             ENDIF
  675.             oObject=this.&lcName
  676.             IF ISNULL(oObject)
  677.                 LOOP
  678.             ENDIF
  679.             IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
  680.                 oObject.Release
  681.             ENDIF
  682.             IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
  683.                 oObject.oHost=.NULL.
  684.             ENDIF
  685.             this.&lcName=.NULL.
  686.             oObject=.NULL.
  687.         ENDFOR
  688.         DIMENSION this.aObjectRefs[1,3]
  689.         this.aObjectRefs=""
  690.     ENDPROC
  691.  
  692.  
  693.     PROCEDURE nobjectrefcount_access
  694.         LOCAL lnObjectRefCount
  695.  
  696.         lnObjectRefCount=ALEN(this.aObjectRefs,1)
  697.         IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
  698.             lnObjectRefCount=0
  699.         ENDIF
  700.         RETURN lnObjectRefCount
  701.     ENDPROC
  702.  
  703.  
  704.     PROCEDURE nobjectrefcount_assign
  705.         LPARAMETERS m.vNewVal
  706.  
  707.         ERROR 1743
  708.     ENDPROC
  709.  
  710.  
  711.     PROCEDURE sethost
  712.         this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
  713.     ENDPROC
  714.  
  715.  
  716.     PROCEDURE newinstance
  717.         LPARAMETERS tnDataSessionID
  718.         LOCAL oNewObject,lnLastDataSessionID
  719.  
  720.         lnLastDataSessionID=SET("DATASESSION")
  721.         IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
  722.             SET DATASESSION TO tnDataSessionID
  723.         ENDIF
  724.         oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
  725.         SET DATASESSION TO (lnLastDataSessionID)
  726.         RETURN oNewObject
  727.     ENDPROC
  728.  
  729.  
  730.     PROCEDURE Destroy
  731.         IF this.lRelease
  732.             RETURN .F.
  733.         ENDIF
  734.         this.lRelease=.T.
  735.         this.ReleaseObjRefs
  736.         this.oHost=.NULL.
  737.     ENDPROC
  738.  
  739.  
  740.     PROCEDURE Init
  741.         IF this.lSetHost
  742.             this.SetHost
  743.         ENDIF
  744.         IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
  745.             RETURN .F.
  746.         ENDIF
  747.     ENDPROC
  748.  
  749.  
  750.     PROCEDURE Error
  751.         LPARAMETERS nError, cMethod, nLine
  752.         LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
  753.  
  754.         IF this.lIgnoreErrors
  755.             RETURN .F.
  756.         ENDIF
  757.         lcOnError=UPPER(ALLTRIM(ON("ERROR")))
  758.         IF NOT EMPTY(lcOnError)
  759.             lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
  760.                     "PROGRAM()","cMethod"),"LINENO()","nLine")
  761.             &lcOnError
  762.             RETURN
  763.         ENDIF
  764.         lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
  765.                 "Error:           "+ALLTRIM(STR(nError))+CHR(13)+ ;
  766.                 "Method:       "+LOWER(ALLTRIM(cMethod))
  767.         lcCodeLineMsg=MESSAGE(1)
  768.         IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
  769.             lcErrorMsg=lcErrorMsg+CHR(13)+"Line:            "+ALLTRIM(STR(nLine))
  770.             IF NOT EMPTY(lcCodeLineMsg)
  771.                 lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  772.             ENDIF
  773.         ENDIF
  774.         WAIT CLEAR
  775.         MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
  776.         ERROR nError
  777.     ENDPROC
  778.  
  779.  
  780. ENDDEFINE
  781. *
  782. *-- EndDefine: _header
  783. **************************************************
  784.  
  785.  
  786.  
  787.  
  788.  
  789. **************************************************
  790. *-- Class:        _olecontrol (d:\vfp\ffc\_base.prg)
  791. *-- ParentClass:  olecontrol 
  792. *-- BaseClass:    olecontrol 
  793. *
  794. DEFINE CLASS _olecontrol AS olecontrol
  795.  
  796.  
  797.     Name = "_olecontrol"
  798.     cVersion = ""
  799.     Builder = ""
  800.     BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm")
  801.     oHost = .NULL.
  802.     vResult = .T.
  803.     cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
  804.     lAutoBuilder = .F.
  805.     lAutoSetObjectRefs = .F.
  806.     lRelease = .F.
  807.     lIgnoreErrors = .F.
  808.     lSetHost = .F.
  809.     nInstances = 0
  810.     nObjectRefCount = 0
  811.     DIMENSION aObjectRefs[1,3]
  812.  
  813.  
  814.     PROCEDURE nInstances_access
  815.     LOCAL laInstances[1]
  816.     
  817.     RETURN AINSTANCE(laInstances,this.Class)
  818.     ENDPROC
  819.  
  820.  
  821.     PROCEDURE nInstances_assign
  822.         LPARAMETERS m.vNewVal
  823.  
  824.         ERROR 1743
  825.     ENDPROC
  826.  
  827.  
  828.     PROCEDURE release
  829.         IF this.lRelease
  830.             NODEFAULT
  831.             RETURN .F.
  832.         ENDIF
  833.         this.lRelease=.T.
  834.         this.oHost=.NULL.
  835.         this.ReleaseObjRefs
  836.         RELEASE this
  837.     ENDPROC
  838.  
  839.  
  840.     PROCEDURE setobjectref
  841.         LPARAMETERS tcName,tvClass,tvClassLibrary
  842.         LOCAL lvResult
  843.  
  844.         this.vResult=.T.
  845.         DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
  846.         lvResult=this.vResult
  847.         this.vResult=.T.
  848.         RETURN lvResult
  849.     ENDPROC
  850.  
  851.  
  852.     PROCEDURE setobjectrefs
  853.         LPARAMETERS toObject
  854.  
  855.         RETURN
  856.     ENDPROC
  857.  
  858.  
  859.     PROCEDURE releaseobjrefs
  860.         LOCAL lcName,oObject,lnCount
  861.  
  862.         IF this.nObjectRefCount=0
  863.             RETURN
  864.         ENDIF
  865.         FOR lnCount = this.nObjectRefCount TO 1 STEP -1
  866.             lcName=this.aObjectRefs[lnCount,1]
  867.             IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
  868.                 LOOP
  869.             ENDIF
  870.             oObject=this.&lcName
  871.             IF ISNULL(oObject)
  872.                 LOOP
  873.             ENDIF
  874.             IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
  875.                 oObject.Release
  876.             ENDIF
  877.             IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
  878.                 oObject.oHost=.NULL.
  879.             ENDIF
  880.             this.&lcName=.NULL.
  881.             oObject=.NULL.
  882.         ENDFOR
  883.         DIMENSION this.aObjectRefs[1,3]
  884.         this.aObjectRefs=""
  885.     ENDPROC
  886.  
  887.  
  888.     PROCEDURE nobjectrefcount_access
  889.         LOCAL lnObjectRefCount
  890.  
  891.         lnObjectRefCount=ALEN(this.aObjectRefs,1)
  892.         IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
  893.             lnObjectRefCount=0
  894.         ENDIF
  895.         RETURN lnObjectRefCount
  896.     ENDPROC
  897.  
  898.  
  899.     PROCEDURE nobjectrefcount_assign
  900.         LPARAMETERS m.vNewVal
  901.  
  902.         ERROR 1743
  903.     ENDPROC
  904.  
  905.  
  906.     PROCEDURE sethost
  907.         this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
  908.     ENDPROC
  909.  
  910.  
  911.     PROCEDURE newinstance
  912.         LPARAMETERS tnDataSessionID
  913.         LOCAL oNewObject,lnLastDataSessionID
  914.  
  915.         lnLastDataSessionID=SET("DATASESSION")
  916.         IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
  917.             SET DATASESSION TO tnDataSessionID
  918.         ENDIF
  919.         oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
  920.         SET DATASESSION TO (lnLastDataSessionID)
  921.         RETURN oNewObject
  922.     ENDPROC
  923.  
  924.  
  925.     PROCEDURE Destroy
  926.         IF this.lRelease
  927.             RETURN .F.
  928.         ENDIF
  929.         this.lRelease=.T.
  930.         this.ReleaseObjRefs
  931.         this.oHost=.NULL.
  932.     ENDPROC
  933.  
  934.  
  935.     PROCEDURE Init
  936.         IF this.lSetHost
  937.             this.SetHost
  938.         ENDIF
  939.         IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
  940.             RETURN .F.
  941.         ENDIF
  942.     ENDPROC
  943.  
  944.  
  945.     PROCEDURE Error
  946.         LPARAMETERS nError, cMethod, nLine
  947.         LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
  948.  
  949.         IF this.lIgnoreErrors
  950.             RETURN .F.
  951.         ENDIF
  952.         lcOnError=UPPER(ALLTRIM(ON("ERROR")))
  953.         IF NOT EMPTY(lcOnError)
  954.             lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
  955.                     "PROGRAM()","cMethod"),"LINENO()","nLine")
  956.             &lcOnError
  957.             RETURN
  958.         ENDIF
  959.         lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
  960.                 "Error:           "+ALLTRIM(STR(nError))+CHR(13)+ ;
  961.                 "Method:       "+LOWER(ALLTRIM(cMethod))
  962.         lcCodeLineMsg=MESSAGE(1)
  963.         IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
  964.             lcErrorMsg=lcErrorMsg+CHR(13)+"Line:            "+ALLTRIM(STR(nLine))
  965.             IF NOT EMPTY(lcCodeLineMsg)
  966.                 lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  967.             ENDIF
  968.         ENDIF
  969.         WAIT CLEAR
  970.         MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
  971.         ERROR nError
  972.     ENDPROC
  973.  
  974.  
  975. ENDDEFINE
  976. *
  977. *-- EndDefine: _olecontrol
  978. **************************************************
  979.  
  980.  
  981.  
  982.  
  983.  
  984. **************************************************
  985. *-- Class:        _oleboundcontrol (d:\vfp\ffc\_base.prg)
  986. *-- ParentClass:  oleboundcontrol 
  987. *-- BaseClass:    oleboundcontrol 
  988. *
  989. DEFINE CLASS _oleboundcontrol AS oleboundcontrol
  990.  
  991.  
  992.     Name = "_oleboundcontrol"
  993.     cVersion = ""
  994.     Builder = ""
  995.     BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm")
  996.     oHost = .NULL.
  997.     vResult = .T.
  998.     cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
  999.     lAutoBuilder = .F.
  1000.     lAutoSetObjectRefs = .F.
  1001.     lRelease = .F.
  1002.     lIgnoreErrors = .F.
  1003.     lSetHost = .F.
  1004.     nInstances = 0
  1005.     nObjectRefCount = 0
  1006.     DIMENSION aObjectRefs[1,3]
  1007.  
  1008.  
  1009.     PROCEDURE nInstances_access
  1010.     LOCAL laInstances[1]
  1011.     
  1012.     RETURN AINSTANCE(laInstances,this.Class)
  1013.     ENDPROC
  1014.  
  1015.  
  1016.     PROCEDURE nInstances_assign
  1017.         LPARAMETERS m.vNewVal
  1018.  
  1019.         ERROR 1743
  1020.     ENDPROC
  1021.  
  1022.  
  1023.     PROCEDURE release
  1024.         IF this.lRelease
  1025.             NODEFAULT
  1026.             RETURN .F.
  1027.         ENDIF
  1028.         this.lRelease=.T.
  1029.         this.oHost=.NULL.
  1030.         this.ReleaseObjRefs
  1031.         RELEASE this
  1032.     ENDPROC
  1033.  
  1034.  
  1035.     PROCEDURE setobjectref
  1036.         LPARAMETERS tcName,tvClass,tvClassLibrary
  1037.         LOCAL lvResult
  1038.  
  1039.         this.vResult=.T.
  1040.         DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
  1041.         lvResult=this.vResult
  1042.         this.vResult=.T.
  1043.         RETURN lvResult
  1044.     ENDPROC
  1045.  
  1046.  
  1047.     PROCEDURE setobjectrefs
  1048.         LPARAMETERS toObject
  1049.  
  1050.         RETURN
  1051.     ENDPROC
  1052.  
  1053.  
  1054.     PROCEDURE releaseobjrefs
  1055.         LOCAL lcName,oObject,lnCount
  1056.  
  1057.         IF this.nObjectRefCount=0
  1058.             RETURN
  1059.         ENDIF
  1060.         FOR lnCount = this.nObjectRefCount TO 1 STEP -1
  1061.             lcName=this.aObjectRefs[lnCount,1]
  1062.             IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
  1063.                 LOOP
  1064.             ENDIF
  1065.             oObject=this.&lcName
  1066.             IF ISNULL(oObject)
  1067.                 LOOP
  1068.             ENDIF
  1069.             IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
  1070.                 oObject.Release
  1071.             ENDIF
  1072.             IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
  1073.                 oObject.oHost=.NULL.
  1074.             ENDIF
  1075.             this.&lcName=.NULL.
  1076.             oObject=.NULL.
  1077.         ENDFOR
  1078.         DIMENSION this.aObjectRefs[1,3]
  1079.         this.aObjectRefs=""
  1080.     ENDPROC
  1081.  
  1082.  
  1083.     PROCEDURE nobjectrefcount_access
  1084.         LOCAL lnObjectRefCount
  1085.  
  1086.         lnObjectRefCount=ALEN(this.aObjectRefs,1)
  1087.         IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
  1088.             lnObjectRefCount=0
  1089.         ENDIF
  1090.         RETURN lnObjectRefCount
  1091.     ENDPROC
  1092.  
  1093.  
  1094.     PROCEDURE nobjectrefcount_assign
  1095.         LPARAMETERS m.vNewVal
  1096.  
  1097.         ERROR 1743
  1098.     ENDPROC
  1099.  
  1100.  
  1101.     PROCEDURE sethost
  1102.         this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
  1103.     ENDPROC
  1104.  
  1105.  
  1106.     PROCEDURE newinstance
  1107.         LPARAMETERS tnDataSessionID
  1108.         LOCAL oNewObject,lnLastDataSessionID
  1109.  
  1110.         lnLastDataSessionID=SET("DATASESSION")
  1111.         IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
  1112.             SET DATASESSION TO tnDataSessionID
  1113.         ENDIF
  1114.         oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
  1115.         SET DATASESSION TO (lnLastDataSessionID)
  1116.         RETURN oNewObject
  1117.     ENDPROC
  1118.  
  1119.  
  1120.     PROCEDURE Destroy
  1121.         IF this.lRelease
  1122.             RETURN .F.
  1123.         ENDIF
  1124.         this.lRelease=.T.
  1125.         this.ReleaseObjRefs
  1126.         this.oHost=.NULL.
  1127.     ENDPROC
  1128.  
  1129.  
  1130.     PROCEDURE Init
  1131.         IF this.lSetHost
  1132.             this.SetHost
  1133.         ENDIF
  1134.         IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
  1135.             RETURN .F.
  1136.         ENDIF
  1137.     ENDPROC
  1138.  
  1139.  
  1140.     PROCEDURE Error
  1141.         LPARAMETERS nError, cMethod, nLine
  1142.         LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
  1143.  
  1144.         IF this.lIgnoreErrors
  1145.             RETURN .F.
  1146.         ENDIF
  1147.         lcOnError=UPPER(ALLTRIM(ON("ERROR")))
  1148.         IF NOT EMPTY(lcOnError)
  1149.             lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
  1150.                     "PROGRAM()","cMethod"),"LINENO()","nLine")
  1151.             &lcOnError
  1152.             RETURN
  1153.         ENDIF
  1154.         lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
  1155.                 "Error:           "+ALLTRIM(STR(nError))+CHR(13)+ ;
  1156.                 "Method:       "+LOWER(ALLTRIM(cMethod))
  1157.         lcCodeLineMsg=MESSAGE(1)
  1158.         IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
  1159.             lcErrorMsg=lcErrorMsg+CHR(13)+"Line:            "+ALLTRIM(STR(nLine))
  1160.             IF NOT EMPTY(lcCodeLineMsg)
  1161.                 lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  1162.             ENDIF
  1163.         ENDIF
  1164.         WAIT CLEAR
  1165.         MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
  1166.         ERROR nError
  1167.     ENDPROC
  1168.  
  1169.  
  1170. ENDDEFINE
  1171. *
  1172. *-- EndDefine: _oleboundcontrol
  1173. **************************************************
  1174.  
  1175.  
  1176.  
  1177.  
  1178.  
  1179. **************************************************
  1180. *-- Class:        _optionbutton (d:\vfp\ffc\_base.prg)
  1181. *-- ParentClass:  optionbutton
  1182. *-- BaseClass:    optionbutton
  1183. *
  1184. DEFINE CLASS _optionbutton AS optionbutton
  1185.  
  1186.  
  1187.     Name = "_optionbutton"
  1188.     cVersion = ""
  1189.     Builder = ""
  1190.     BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm")
  1191.     oHost = .NULL.
  1192.     vResult = .T.
  1193.     cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
  1194.     lAutoBuilder = .F.
  1195.     lAutoSetObjectRefs = .F.
  1196.     lRelease = .F.
  1197.     lIgnoreErrors = .F.
  1198.     lSetHost = .F.
  1199.     nInstances = 0
  1200.     nObjectRefCount = 0
  1201.     DIMENSION aObjectRefs[1,3]
  1202.  
  1203.  
  1204.     PROCEDURE nInstances_access
  1205.     LOCAL laInstances[1]
  1206.     
  1207.     RETURN AINSTANCE(laInstances,this.Class)
  1208.     ENDPROC
  1209.  
  1210.  
  1211.     PROCEDURE nInstances_assign
  1212.         LPARAMETERS m.vNewVal
  1213.  
  1214.         ERROR 1743
  1215.     ENDPROC
  1216.  
  1217.  
  1218.     PROCEDURE release
  1219.         IF this.lRelease
  1220.             NODEFAULT
  1221.             RETURN .F.
  1222.         ENDIF
  1223.         this.lRelease=.T.
  1224.         this.oHost=.NULL.
  1225.         this.ReleaseObjRefs
  1226.         RELEASE this
  1227.     ENDPROC
  1228.  
  1229.  
  1230.     PROCEDURE setobjectref
  1231.         LPARAMETERS tcName,tvClass,tvClassLibrary
  1232.         LOCAL lvResult
  1233.  
  1234.         this.vResult=.T.
  1235.         DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
  1236.         lvResult=this.vResult
  1237.         this.vResult=.T.
  1238.         RETURN lvResult
  1239.     ENDPROC
  1240.  
  1241.  
  1242.     PROCEDURE setobjectrefs
  1243.         LPARAMETERS toObject
  1244.  
  1245.         RETURN
  1246.     ENDPROC
  1247.  
  1248.  
  1249.     PROCEDURE releaseobjrefs
  1250.         LOCAL lcName,oObject,lnCount
  1251.  
  1252.         IF this.nObjectRefCount=0
  1253.             RETURN
  1254.         ENDIF
  1255.         FOR lnCount = this.nObjectRefCount TO 1 STEP -1
  1256.             lcName=this.aObjectRefs[lnCount,1]
  1257.             IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
  1258.                 LOOP
  1259.             ENDIF
  1260.             oObject=this.&lcName
  1261.             IF ISNULL(oObject)
  1262.                 LOOP
  1263.             ENDIF
  1264.             IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
  1265.                 oObject.Release
  1266.             ENDIF
  1267.             IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
  1268.                 oObject.oHost=.NULL.
  1269.             ENDIF
  1270.             this.&lcName=.NULL.
  1271.             oObject=.NULL.
  1272.         ENDFOR
  1273.         DIMENSION this.aObjectRefs[1,3]
  1274.         this.aObjectRefs=""
  1275.     ENDPROC
  1276.  
  1277.  
  1278.     PROCEDURE nobjectrefcount_access
  1279.         LOCAL lnObjectRefCount
  1280.  
  1281.         lnObjectRefCount=ALEN(this.aObjectRefs,1)
  1282.         IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
  1283.             lnObjectRefCount=0
  1284.         ENDIF
  1285.         RETURN lnObjectRefCount
  1286.     ENDPROC
  1287.  
  1288.  
  1289.     PROCEDURE nobjectrefcount_assign
  1290.         LPARAMETERS m.vNewVal
  1291.  
  1292.         ERROR 1743
  1293.     ENDPROC
  1294.  
  1295.  
  1296.     PROCEDURE sethost
  1297.         this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
  1298.     ENDPROC
  1299.  
  1300.  
  1301.     PROCEDURE newinstance
  1302.         LPARAMETERS tnDataSessionID
  1303.         LOCAL oNewObject,lnLastDataSessionID
  1304.  
  1305.         lnLastDataSessionID=SET("DATASESSION")
  1306.         IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
  1307.             SET DATASESSION TO tnDataSessionID
  1308.         ENDIF
  1309.         oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
  1310.         SET DATASESSION TO (lnLastDataSessionID)
  1311.         RETURN oNewObject
  1312.     ENDPROC
  1313.  
  1314.  
  1315.     PROCEDURE Destroy
  1316.         IF this.lRelease
  1317.             RETURN .F.
  1318.         ENDIF
  1319.         this.lRelease=.T.
  1320.         this.ReleaseObjRefs
  1321.         this.oHost=.NULL.
  1322.     ENDPROC
  1323.  
  1324.  
  1325.     PROCEDURE Init
  1326.         IF this.lSetHost
  1327.             this.SetHost
  1328.         ENDIF
  1329.         IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
  1330.             RETURN .F.
  1331.         ENDIF
  1332.     ENDPROC
  1333.  
  1334.  
  1335.     PROCEDURE Error
  1336.         LPARAMETERS nError, cMethod, nLine
  1337.         LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
  1338.  
  1339.         IF this.lIgnoreErrors
  1340.             RETURN .F.
  1341.         ENDIF
  1342.         lcOnError=UPPER(ALLTRIM(ON("ERROR")))
  1343.         IF NOT EMPTY(lcOnError)
  1344.             lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
  1345.                     "PROGRAM()","cMethod"),"LINENO()","nLine")
  1346.             &lcOnError
  1347.             RETURN
  1348.         ENDIF
  1349.         lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
  1350.                 "Error:           "+ALLTRIM(STR(nError))+CHR(13)+ ;
  1351.                 "Method:       "+LOWER(ALLTRIM(cMethod))
  1352.         lcCodeLineMsg=MESSAGE(1)
  1353.         IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
  1354.             lcErrorMsg=lcErrorMsg+CHR(13)+"Line:            "+ALLTRIM(STR(nLine))
  1355.             IF NOT EMPTY(lcCodeLineMsg)
  1356.                 lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  1357.             ENDIF
  1358.         ENDIF
  1359.         WAIT CLEAR
  1360.         MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
  1361.         ERROR nError
  1362.     ENDPROC
  1363.  
  1364.  
  1365. ENDDEFINE
  1366. *
  1367. *-- EndDefine: _optionbutton
  1368. **************************************************
  1369.  
  1370.  
  1371.  
  1372.  
  1373.  
  1374. **************************************************
  1375. *-- Class:        _page (d:\vfp\ffc\_base.prg)
  1376. *-- ParentClass:  page
  1377. *-- BaseClass:    page
  1378. *
  1379. DEFINE CLASS _page AS page
  1380.  
  1381.  
  1382.     Name = "_page"
  1383.     cVersion = ""
  1384.     Builder = ""
  1385.     BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm")
  1386.     oHost = .NULL.
  1387.     vResult = .T.
  1388.     cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
  1389.     lAutoBuilder = .F.
  1390.     lAutoSetObjectRefs = .F.
  1391.     lRelease = .F.
  1392.     lIgnoreErrors = .F.
  1393.     lSetHost = .F.
  1394.     nInstances = 0
  1395.     nObjectRefCount = 0
  1396.     DIMENSION aObjectRefs[1,3]
  1397.  
  1398.  
  1399.     PROCEDURE nInstances_access
  1400.     LOCAL laInstances[1]
  1401.     
  1402.     RETURN AINSTANCE(laInstances,this.Class)
  1403.     ENDPROC
  1404.  
  1405.  
  1406.     PROCEDURE nInstances_assign
  1407.         LPARAMETERS m.vNewVal
  1408.  
  1409.         ERROR 1743
  1410.     ENDPROC
  1411.  
  1412.  
  1413.     PROCEDURE release
  1414.         IF this.lRelease
  1415.             NODEFAULT
  1416.             RETURN .F.
  1417.         ENDIF
  1418.         this.lRelease=.T.
  1419.         this.oHost=.NULL.
  1420.         this.ReleaseObjRefs
  1421.         RELEASE this
  1422.     ENDPROC
  1423.  
  1424.  
  1425.     PROCEDURE setobjectref
  1426.         LPARAMETERS tcName,tvClass,tvClassLibrary
  1427.         LOCAL lvResult
  1428.  
  1429.         this.vResult=.T.
  1430.         DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
  1431.         lvResult=this.vResult
  1432.         this.vResult=.T.
  1433.         RETURN lvResult
  1434.     ENDPROC
  1435.  
  1436.  
  1437.     PROCEDURE setobjectrefs
  1438.         LPARAMETERS toObject
  1439.  
  1440.         RETURN
  1441.     ENDPROC
  1442.  
  1443.  
  1444.     PROCEDURE releaseobjrefs
  1445.         LOCAL lcName,oObject,lnCount
  1446.  
  1447.         IF this.nObjectRefCount=0
  1448.             RETURN
  1449.         ENDIF
  1450.         FOR lnCount = this.nObjectRefCount TO 1 STEP -1
  1451.             lcName=this.aObjectRefs[lnCount,1]
  1452.             IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
  1453.                 LOOP
  1454.             ENDIF
  1455.             oObject=this.&lcName
  1456.             IF ISNULL(oObject)
  1457.                 LOOP
  1458.             ENDIF
  1459.             IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
  1460.                 oObject.Release
  1461.             ENDIF
  1462.             IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
  1463.                 oObject.oHost=.NULL.
  1464.             ENDIF
  1465.             this.&lcName=.NULL.
  1466.             oObject=.NULL.
  1467.         ENDFOR
  1468.         DIMENSION this.aObjectRefs[1,3]
  1469.         this.aObjectRefs=""
  1470.     ENDPROC
  1471.  
  1472.  
  1473.     PROCEDURE nobjectrefcount_access
  1474.         LOCAL lnObjectRefCount
  1475.  
  1476.         lnObjectRefCount=ALEN(this.aObjectRefs,1)
  1477.         IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
  1478.             lnObjectRefCount=0
  1479.         ENDIF
  1480.         RETURN lnObjectRefCount
  1481.     ENDPROC
  1482.  
  1483.  
  1484.     PROCEDURE nobjectrefcount_assign
  1485.         LPARAMETERS m.vNewVal
  1486.  
  1487.         ERROR 1743
  1488.     ENDPROC
  1489.  
  1490.  
  1491.     PROCEDURE sethost
  1492.         this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
  1493.     ENDPROC
  1494.  
  1495.  
  1496.     PROCEDURE newinstance
  1497.         LPARAMETERS tnDataSessionID
  1498.         LOCAL oNewObject,lnLastDataSessionID
  1499.  
  1500.         lnLastDataSessionID=SET("DATASESSION")
  1501.         IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
  1502.             SET DATASESSION TO tnDataSessionID
  1503.         ENDIF
  1504.         oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
  1505.         SET DATASESSION TO (lnLastDataSessionID)
  1506.         RETURN oNewObject
  1507.     ENDPROC
  1508.  
  1509.  
  1510.     PROCEDURE Destroy
  1511.         IF this.lRelease
  1512.             RETURN .F.
  1513.         ENDIF
  1514.         this.lRelease=.T.
  1515.         this.ReleaseObjRefs
  1516.         this.oHost=.NULL.
  1517.     ENDPROC
  1518.  
  1519.  
  1520.     PROCEDURE Init
  1521.         IF this.lSetHost
  1522.             this.SetHost
  1523.         ENDIF
  1524.         IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
  1525.             RETURN .F.
  1526.         ENDIF
  1527.     ENDPROC
  1528.  
  1529.  
  1530.     PROCEDURE Error
  1531.         LPARAMETERS nError, cMethod, nLine
  1532.         LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
  1533.  
  1534.         IF this.lIgnoreErrors
  1535.             RETURN .F.
  1536.         ENDIF
  1537.         lcOnError=UPPER(ALLTRIM(ON("ERROR")))
  1538.         IF NOT EMPTY(lcOnError)
  1539.             lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
  1540.                     "PROGRAM()","cMethod"),"LINENO()","nLine")
  1541.             &lcOnError
  1542.             RETURN
  1543.         ENDIF
  1544.         lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
  1545.                 "Error:           "+ALLTRIM(STR(nError))+CHR(13)+ ;
  1546.                 "Method:       "+LOWER(ALLTRIM(cMethod))
  1547.         lcCodeLineMsg=MESSAGE(1)
  1548.         IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
  1549.             lcErrorMsg=lcErrorMsg+CHR(13)+"Line:            "+ALLTRIM(STR(nLine))
  1550.             IF NOT EMPTY(lcCodeLineMsg)
  1551.                 lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  1552.             ENDIF
  1553.         ENDIF
  1554.         WAIT CLEAR
  1555.         MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
  1556.         ERROR nError
  1557.     ENDPROC
  1558.  
  1559.  
  1560. ENDDEFINE
  1561. *
  1562. *-- EndDefine: _page
  1563. **************************************************
  1564.  
  1565.  
  1566.  
  1567.  
  1568.  
  1569. **************************************************
  1570. *-- Class:        _relation (d:\vfp\ffc\_base.prg)
  1571. *-- ParentClass:  relation 
  1572. *-- BaseClass:    relation 
  1573. *
  1574. DEFINE CLASS _relation AS relation
  1575.  
  1576.  
  1577.     Name = "_relation"
  1578.     cVersion = ""
  1579.     Builder = ""
  1580.     BuilderX = (HOME()+"Wizards\BuilderD,BuilderDForm")
  1581.     oHost = .NULL.
  1582.     vResult = .T.
  1583.     cSetObjRefProgram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg")
  1584.     lAutoBuilder = .F.
  1585.     lAutoSetObjectRefs = .F.
  1586.     lRelease = .F.
  1587.     lIgnoreErrors = .F.
  1588.     lSetHost = .F.
  1589.     nInstances = 0
  1590.     nObjectRefCount = 0
  1591.     DIMENSION aObjectRefs[1,3]
  1592.  
  1593.  
  1594.     PROCEDURE nInstances_access
  1595.     LOCAL laInstances[1]
  1596.     
  1597.     RETURN AINSTANCE(laInstances,this.Class)
  1598.     ENDPROC
  1599.  
  1600.  
  1601.     PROCEDURE nInstances_assign
  1602.         LPARAMETERS m.vNewVal
  1603.  
  1604.         ERROR 1743
  1605.     ENDPROC
  1606.  
  1607.  
  1608.     PROCEDURE release
  1609.         IF this.lRelease
  1610.             NODEFAULT
  1611.             RETURN .F.
  1612.         ENDIF
  1613.         this.lRelease=.T.
  1614.         this.oHost=.NULL.
  1615.         this.ReleaseObjRefs
  1616.         RELEASE this
  1617.     ENDPROC
  1618.  
  1619.  
  1620.     PROCEDURE setobjectref
  1621.         LPARAMETERS tcName,tvClass,tvClassLibrary
  1622.         LOCAL lvResult
  1623.  
  1624.         this.vResult=.T.
  1625.         DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary)
  1626.         lvResult=this.vResult
  1627.         this.vResult=.T.
  1628.         RETURN lvResult
  1629.     ENDPROC
  1630.  
  1631.  
  1632.     PROCEDURE setobjectrefs
  1633.         LPARAMETERS toObject
  1634.  
  1635.         RETURN
  1636.     ENDPROC
  1637.  
  1638.  
  1639.     PROCEDURE releaseobjrefs
  1640.         LOCAL lcName,oObject,lnCount
  1641.  
  1642.         IF this.nObjectRefCount=0
  1643.             RETURN
  1644.         ENDIF
  1645.         FOR lnCount = this.nObjectRefCount TO 1 STEP -1
  1646.             lcName=this.aObjectRefs[lnCount,1]
  1647.             IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O"
  1648.                 LOOP
  1649.             ENDIF
  1650.             oObject=this.&lcName
  1651.             IF ISNULL(oObject)
  1652.                 LOOP
  1653.             ENDIF
  1654.             IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5)
  1655.                 oObject.Release
  1656.             ENDIF
  1657.             IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5)
  1658.                 oObject.oHost=.NULL.
  1659.             ENDIF
  1660.             this.&lcName=.NULL.
  1661.             oObject=.NULL.
  1662.         ENDFOR
  1663.         DIMENSION this.aObjectRefs[1,3]
  1664.         this.aObjectRefs=""
  1665.     ENDPROC
  1666.  
  1667.  
  1668.     PROCEDURE nobjectrefcount_access
  1669.         LOCAL lnObjectRefCount
  1670.  
  1671.         lnObjectRefCount=ALEN(this.aObjectRefs,1)
  1672.         IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1])
  1673.             lnObjectRefCount=0
  1674.         ENDIF
  1675.         RETURN lnObjectRefCount
  1676.     ENDPROC
  1677.  
  1678.  
  1679.     PROCEDURE nobjectrefcount_assign
  1680.         LPARAMETERS m.vNewVal
  1681.  
  1682.         ERROR 1743
  1683.     ENDPROC
  1684.  
  1685.  
  1686.     PROCEDURE sethost
  1687.         this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.)
  1688.     ENDPROC
  1689.  
  1690.  
  1691.     PROCEDURE newinstance
  1692.         LPARAMETERS tnDataSessionID
  1693.         LOCAL oNewObject,lnLastDataSessionID
  1694.  
  1695.         lnLastDataSessionID=SET("DATASESSION")
  1696.         IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1
  1697.             SET DATASESSION TO tnDataSessionID
  1698.         ENDIF
  1699.         oNewObject=NEWOBJECT(this.Class,this.ClassLibrary)
  1700.         SET DATASESSION TO (lnLastDataSessionID)
  1701.         RETURN oNewObject
  1702.     ENDPROC
  1703.  
  1704.  
  1705.     PROCEDURE Destroy
  1706.         IF this.lRelease
  1707.             RETURN .F.
  1708.         ENDIF
  1709.         this.lRelease=.T.
  1710.         this.ReleaseObjRefs
  1711.         this.oHost=.NULL.
  1712.     ENDPROC
  1713.  
  1714.  
  1715.     PROCEDURE Init
  1716.         IF this.lSetHost
  1717.             this.SetHost
  1718.         ENDIF
  1719.         IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this)
  1720.             RETURN .F.
  1721.         ENDIF
  1722.     ENDPROC
  1723.  
  1724.  
  1725.     PROCEDURE Error
  1726.         LPARAMETERS nError, cMethod, nLine
  1727.         LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg
  1728.  
  1729.         IF this.lIgnoreErrors
  1730.             RETURN .F.
  1731.         ENDIF
  1732.         lcOnError=UPPER(ALLTRIM(ON("ERROR")))
  1733.         IF NOT EMPTY(lcOnError)
  1734.             lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ;
  1735.                     "PROGRAM()","cMethod"),"LINENO()","nLine")
  1736.             &lcOnError
  1737.             RETURN
  1738.         ENDIF
  1739.         lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ;
  1740.                 "Error:           "+ALLTRIM(STR(nError))+CHR(13)+ ;
  1741.                 "Method:       "+LOWER(ALLTRIM(cMethod))
  1742.         lcCodeLineMsg=MESSAGE(1)
  1743.         IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..."
  1744.             lcErrorMsg=lcErrorMsg+CHR(13)+"Line:            "+ALLTRIM(STR(nLine))
  1745.             IF NOT EMPTY(lcCodeLineMsg)
  1746.                 lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg
  1747.             ENDIF
  1748.         ENDIF
  1749.         WAIT CLEAR
  1750.         MESSAGEBOX(lcErrorMsg,16,_screen.Caption)
  1751.         ERROR nError
  1752.     ENDPROC
  1753.  
  1754.  
  1755. ENDDEFINE
  1756. *
  1757. *-- EndDefine: _relation
  1758. **************************************************
  1759.